home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / DDIGI.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-01  |  7KB  |  367 lines
  1.  
  2. unit ddigi;
  3. {$S-,V-,R-}
  4.  
  5. interface
  6. uses dos;
  7.  
  8. type
  9.  Idarray = array[1..8] of char;
  10.  
  11. var
  12.  AsyncStat:word;
  13.  dport_num: integer;
  14.  nameptr : ^idarray;
  15.  OutReady:boolean;
  16.  
  17. function  digi_Init_driver : boolean;
  18. function  digi_deinit_driver: boolean;
  19. function  digi_buffer_check: boolean;
  20. procedure digi_send(c: char);
  21. function  digi_receive(var c: char): boolean;
  22. function  digi_carrier_present : boolean;
  23. procedure digi_set_modem;
  24. function  digi_set_baud(n:longint;WordSize:Byte; Parity:Char; StopBits:Byte): boolean;
  25. procedure digi_flush_io;
  26. procedure digi_flush_input;
  27. procedure digi_flush_output;
  28. procedure digi_Get_Info(var drivername:string);
  29. procedure EnableTimeOutError;
  30. procedure Digi_Break(StatusCode : Word);
  31.  
  32. implementation
  33. const
  34.   dtrmask = 1;
  35.   rtsmask = 2;
  36. type
  37.   BytePtr = ^Byte;
  38. var
  39.   EBIOSok,DTRok,RTSok    : boolean;
  40.   CharReadyP : BytePtr;
  41.  
  42. function digi_Init_driver : boolean;
  43. var
  44.  regs: registers;
  45. begin;
  46.  with regs do                         { Get Channel Parameters }
  47.    begin
  48.      ah:=$0C;
  49.      dx:=dport_num;
  50.    end;
  51.  intr($14,regs);
  52.  if regs.ah=$FF then
  53.    digi_init_driver :=false
  54.  else
  55.    digi_init_driver :=true;
  56.                                   { Checks for extended Bios }
  57.  asm
  58.    mov ah,$F4
  59.    mov al,$00
  60.    mov dx,dport_num
  61.    int $14
  62.  end;
  63.  If regs.ax=$000 then
  64.    EbiosOk:=true
  65.  else
  66.    EbiosOk:=false;
  67.  
  68.  with regs do                         { checks modem dtr/rts status }
  69.    begin
  70.      ah:=$05;
  71.      al:=$00;
  72.      dx:=dport_num;
  73.    end;
  74.  intr($14,regs);
  75.  if (regs.bl and DTRmask)<>$00 then
  76.    DTRok:=true
  77.  else
  78.    DTRok:=false;
  79.  if (regs.bl and RTSmask)<>$00 then
  80.    RTSok:=true
  81.  else
  82.    RTSok:=false;
  83.  
  84.  OutReady:=false;
  85. end;
  86.  
  87. function  digi_deinit_driver;  { A do nada routine, no deinit calls exist. }
  88. begin
  89.  digi_deinit_driver:=true;
  90. end;
  91.  
  92. function digi_buffer_check: boolean;
  93. var
  94.  regs: registers;
  95. begin;
  96.  with regs do
  97.    begin
  98.      ah:=$03;
  99.      dx:=dport_num;
  100.    end;
  101.  intr($14,regs);
  102.  if (regs.ah and $01)<>$00 then   { data ready bit               }
  103.    digi_buffer_check:=true        { checks if byte ready to send }
  104.  else
  105.    digi_buffer_check:=false;
  106. end;
  107.  
  108. procedure digi_send(c: char);
  109. var
  110.  regs: registers;
  111. begin;
  112.  with regs do
  113.   begin
  114.     ah:=$01;
  115.     al:=byte(c);
  116.     dx:=dport_num;
  117.   end;
  118.  intr($14,regs);
  119.                                { bit 5 set on = buffer space avail }
  120.  if (regs.ah and $20)<>$00 then
  121.    OutReady:=true
  122.  else
  123.    OutReady:=false;
  124. end;
  125.  
  126. function digi_receive(var c: char): boolean;
  127. var
  128.  regs: registers;
  129. begin;
  130.  c:=#0;
  131.  digi_receive:=false;
  132.  if digi_buffer_check then
  133.   begin
  134.     with regs do
  135.     begin
  136.       ah:=$02;
  137.       dx:=dport_num;
  138.     end;
  139.     intr($14,regs);
  140.     if (regs.ah and $8E)=$00 then
  141.       begin
  142.         c:=chr(regs.al);
  143.         digi_receive:=true;
  144.       end;
  145.   end;
  146. end;
  147.  
  148. function digi_carrier_present: boolean;
  149. var
  150.  regs: registers;
  151. begin;
  152.  with regs do
  153.    begin
  154.      ah:=$03;
  155.      dx:=dport_num;
  156.    end;
  157.  intr($14,regs);
  158.  if (regs.al and $80)<>$00 then      { carrier present bit }
  159.    digi_carrier_present:=true
  160.  else
  161.    digi_carrier_present:=false;
  162.  if (regs.ah and $20)<>$00 then      { bit 5 set on = buffer space avail }
  163.    OutReady:=true                    { thus can check if out buffer ready}
  164.  else
  165.    OutReady:=false;
  166. end;
  167.  
  168. function ExtBaud(n:longint) : byte;
  169. var
  170.  b:byte;
  171.  w:word;
  172. begin
  173.  b:=$00;
  174.  w:=n;
  175.  
  176.  If n > 76800 then   { 115200 }
  177.    b:=$0C
  178.  else
  179.  If n > 57600 then   {  76800 }
  180.    b:=$0B
  181.  else
  182.    case w of
  183.      300  : b:=$02;
  184.      600  : b:=$03;
  185.      1200 : b:=$04;
  186.      1800 : b:=$11;
  187.      2400 : b:=$05;
  188.      4800 : b:=$06;
  189.      4801..9600 :  b:=$07;
  190.      9601..19200:  b:=$08;
  191.      19201..38400: b:=$09;
  192.      38401..57600: b:=$0A;
  193.    end;
  194.   ExtBaud:=b;
  195. end;
  196.  
  197. procedure digi_set_modem;
  198. var
  199.   regs: registers;
  200. begin
  201.   with regs do
  202.    begin
  203.      dx:=dport_num;
  204.      ah:=$05;
  205.      al:=$01;
  206.      If dtrok then bl:=bl or dtrmask;
  207.      If rtsok then bl:=bl or rtsmask;
  208.    end;
  209.   intr($14,regs);
  210. end;
  211.  
  212. { This is included for completeness only }
  213. { Most sysops don't want a door to reinitiallize their board }
  214. { so this is by passed.                                      }
  215. function digi_set_baud;      { new form digiboard init }
  216. var
  217.   regs: registers;
  218. begin;
  219.  
  220.   with regs do
  221.    begin
  222.      ah:=$04;
  223.      al:=$00;
  224.      dx:=dport_num;
  225.      case parity of
  226.       'N' : bh:=$00;
  227.       'O' : bh:=$01;
  228.       'E' : bh:=$02;
  229.      end;                  {0 = none/ 1 = odd / 2 = even }
  230.      case stopbits of
  231.        1 : bl:=$00;
  232.        2 : bl:=$01;
  233.      end;
  234.      case wordsize of
  235.        5 : ch:=$00;
  236.        6 : ch:=$01;
  237.        7 : ch:=$02;
  238.        8 : ch:=$03;
  239.      end;
  240.      cl:=ExtBaud(n);      { set baud rate }
  241.   end;
  242.   intr($14,regs);
  243.   if regs.ah=$FF then
  244.     digi_set_baud:=false
  245.   else
  246.    begin
  247.     digi_set_baud:=true;
  248.     digi_set_modem;
  249.    end;
  250. end;
  251.  
  252. procedure digi_flush_io;
  253. var
  254.  regs: registers;
  255. begin;
  256.  regs.ah:=$09;
  257.  regs.dx:=dport_num;
  258.  intr($14,regs);
  259. end;
  260.  
  261. procedure digi_flush_input;
  262. var
  263.  regs: registers;
  264. begin;
  265.  regs.ah:=$10;
  266.  regs.dx:=dport_num;
  267.  intr($14,regs);
  268. end;
  269.  
  270. procedure digi_flush_output;
  271. var
  272.  regs: registers;
  273. begin;
  274.  regs.ah:=$11;
  275.  regs.dx:=dport_num;
  276.  intr($14,regs);
  277. end;
  278.  
  279. procedure digi_Get_Info(var drivername:string);
  280. const
  281.  dname : array[1..5] of
  282.   string [6] = ('COM/Xi','MC/Xi', 'PC/Xe', 'PC/Xi', 'PC/Xm' );
  283. var
  284.  i:byte;
  285.  regs: registers;
  286.  d,s,o:string;
  287.  versno:word;
  288. begin;
  289.  versno:=0;
  290.  d:='';s:='';o:=' ';
  291.  with regs do
  292.   begin
  293.     ah:=$06;
  294.     al:=$ff;
  295.     dx:=dport_num;
  296.   end;
  297.  intr($14,regs);
  298.  nameptr := ptr(regs.es,regs.bx);
  299.  i := 1;
  300.  while (i<8) and (nameptr^[i] <> #0)  do
  301.    inc(i);
  302.  move(nameptr^, d[1], i);
  303.  d[0] := char(i);
  304.  
  305.  with regs do
  306.   begin
  307.     ah:=$06;
  308.     al:=$01;
  309.     dx:=dport_num;
  310.   end;
  311.  intr($14,regs);
  312.  if regs.ah<>$ff then
  313.   begin
  314.     versno:=regs.bx;
  315.     str(versno,o);
  316.     s:=' Version['+o+'] : ';
  317.     str(regs.ax,o);
  318.   end;
  319.  d:=d+s;
  320.  
  321.  s:='';
  322.  
  323.  with regs do
  324.   begin
  325.     ah:=$06;
  326.     al:=$02;
  327.     bx:=$000;
  328.     dx:=dport_num;
  329.   end;
  330.  intr($14,regs);
  331.  if regs.ah<>$ff then
  332.    If regs.al in [$01..$05] then s:=dname[regs.al]
  333.    else str(regs.al,s);
  334.  drivername:=d+s+o;
  335.  
  336. end;
  337.  
  338. procedure EnableTimeOutError;
  339. var
  340.  regs: registers;
  341. begin;
  342.  with regs do
  343.   begin
  344.     ah:=$20;
  345.     al:=$01;
  346.     dx:=dport_num;
  347.   end;
  348.  intr($14,regs);
  349. end;
  350.  
  351. procedure Digi_Break(StatusCode : Word);  { send break }
  352. var
  353.  regs: registers;
  354. begin;
  355.  with regs do
  356.   begin
  357.     ah:=$07;
  358.     al:=$00;       { defaults 250 millisecs }
  359.     dx:=dport_num;
  360.   end;
  361.  intr($14,regs);
  362.  AsyncStat := StatusCode;
  363. end;
  364.  
  365.  
  366. end.
  367.